home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / grep-br.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  29.2 KB  |  814 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         grep-br.lsp
  5. ; RCS:          $Header: grep-br.lsp,v 1.7 91/10/05 17:12:19 mayer Exp $
  6. ; Description:  A file search browser using the Unix "grep" command to perform
  7. ;        search. Has capability to call $EDITOR or XmText editor to view
  8. ;        context    surrounding matching item. See mouse and accelerator bindings
  9. ;        comments below for details on using this. Note customization via
  10. ;               setting variables *SYSTEM-EDITOR*, *GREP-BR-EXECUTABLE* (see below).
  11. ;        For speed, I suggest (setq *GREP-BR-EXECUTABLE* "/usr/local/bin/gnugrep")...
  12. ; Author:       Niels Mayer, HPLabs
  13. ; Created:      Mon Nov 20 18:13:23 1989
  14. ; Modified:     Sat Oct  5 17:11:04 1991 (Niels Mayer) mayer@hplnpm
  15. ; Language:     Lisp
  16. ; Package:      N/A
  17. ; Status:       X11r5 contrib tape release
  18. ;
  19. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  20. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  21. ;
  22. ; Permission to use, copy, modify, distribute, and sell this software and its
  23. ; documentation for any purpose is hereby granted without fee, provided that
  24. ; the above copyright notice appear in all copies and that both that
  25. ; copyright notice and this permission notice appear in supporting
  26. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  27. ; used in advertising or publicity pertaining to distribution of the software
  28. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  29. ; makes no representations about the suitability of this software for any
  30. ; purpose.  It is provided "as is" without express or implied warranty.
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32.  
  33. ;; Resources:
  34. ;;
  35. ;; Mwm*winterpGrepBr*iconImage:    /usr/local/include/X11/bitmaps/search-i.h
  36. ;; Mwm*WinterpGrepBr*iconImage:    /usr/local/include/X11/bitmaps/search-i.h
  37. ;;
  38.  
  39. ;; Mouse bindings on browser:
  40. ;; single left click   -- select item for use by $EDITOR button or middle/right click.
  41. ;; double left click   -- select item and display corresponding text in text viewer.
  42. ;; single middle click -- select item and display corresponding text in text viewer.
  43. ;; single right click  -- select item and display corresponding text in $EDITOR
  44.  
  45. ;; Accelerators on browser:
  46. ;; (Note: bindings available everywhere other than "search regexp" and 
  47. ;; "wildcarded files" editors).
  48. ;;
  49. ;; 'E'  -- view selected item in user's editor.
  50. ;; '^E' -- select next item and view in user's editor.
  51. ;; '^N', ^<DownArrow>  -- select next item
  52. ;; '^P', ^<UpArrow>    -- select prev item
  53. ;; 'N' , <DownArrow>   -- view next item in built-in editor
  54. ;; 'P' , <UpArrow>     -- view prev item in built-in editor
  55.  
  56. ;; Accelerators on editor:
  57. ;; (Note: bindings available everywhere other than "search regexp" and 
  58. ;; "wildcarded files" editors).
  59. ;;
  60. ;; <space>     -- pages forwards
  61. ;; <backspace> -- pages backwards
  62.  
  63.  
  64. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65. ;; the contents of this file have evolved into something that can only work with
  66. ;; Motif 1.1/X11r4. A more rudimentary grep browser is available for Motif 1.0,
  67. ;; in file grep-br1.0.lsp, and we load that if we note you're running Motif 1.0...
  68. ;; Note that the 1.0 version isn't nearly as good as the grep browser in this file. 
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70. (if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))
  71.   (if (not (load "grep-br1.0.lsp"))    ;load failure doesn't signal an error.
  72.       (error "Couldn't load grep-br1.0.lsp -- did you forget to set\nresource .lispLibDir or command-line argument -lib_dir\nto specify the path to the WINTERP examples directory??")
  73.     )
  74. (progn
  75.  
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. ;;; *SYSTEM-EDITOR*:
  78. ;;; if NIL, then edit functionality will use editor set in environment variable 
  79. ;;; $EDITOR. If set to a string, then that string will be used as the name of
  80. ;;; the editor to use for the "Edit" button.
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82. (defvar *SYSTEM-EDITOR* nil)
  83.  
  84. #| ;; NPM: commented out because simple-option-menu has motif bug
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86. ;;; *GREP-EXECUTABLES*
  87. ;;; user may want to customize, by adding the following to their "~/.winterp"
  88. ;;; (setq *GREP-BR-EXECUTABLE* #("grep1" "grep2" "grep3" "grep4"))
  89. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  90. (defvar *GREP-EXECUTABLES* #("grep" "fgrep" "egrep" "gnugrep"))
  91. |# ;; NPM: commented out because simple-option-menu has motif bug
  92.  
  93. ; use this in place of above till option menu fixed.
  94. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95. ;;; *GREP-BR-EXECUTABLE*
  96. ;;; user may want to customize, by adding the following to their "~/.winterp"
  97. ;;; (setq *GREP-BR-EXECUTABLE* "/usr/local/bin/gnugrep")
  98. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99. (defvar *GREP-BR-EXECUTABLE* "grep")
  100.  
  101. ;;
  102. ;; Make it more straightforward to access singleton resources.
  103. ;;
  104. (send WIDGET_CLASS :answer :get '(resource-name)
  105.  '(
  106.    (car (send self :GET_VALUES resource-name NIL))
  107.    ))
  108.  
  109. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  110. ;;;;;;;;;;;;;;;;;;;;;; List_Browser_Widget_Class ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  111. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  112. ;;
  113. ;; Make a subclass of XM_LIST_WIDGET_CLASS which holds an additional
  114. ;; instance variable 'items'. 'items' is an array of arbitrary objects
  115. ;; (BROWSER_OBJECT) to be displayed in a browser made from the list widget.
  116. ;;
  117. ;; BROWSER-OBJECT can be any arbitrary xlisp object that responds to
  118. ;; the message :display_string.
  119. ;;
  120. ;; Message :display_string must return a string which is used as the
  121. ;; textual representation of the object in the browser display.
  122. ;;
  123. (setq List_Browser_Widget_Class
  124.       (send Class :new
  125.         '(items selected_pos)    ;new instance vars
  126.         '()                ;no class vars
  127.         XM_LIST_WIDGET_CLASS))    ;superclass
  128. ;;
  129. ;; Initialization method.
  130. ;;
  131. (send List_Browser_Widget_Class :answer :isnew '(&rest args)
  132.       '(
  133.     ;; initialize the instance variables
  134.     (setq items nil)
  135.     (setq selected_pos nil)
  136.  
  137.     ;; initialize the widget...
  138.     (apply 'send-super `(:isnew
  139.                  ,@args
  140.                  :XMN_SELECTION_POLICY :browse_select
  141.                  ))
  142.  
  143.     ;; add a callback to set selected_pos instance var.
  144.     (send-super :add_callback :XMN_BROWSE_SELECTION_CALLBACK '(CALLBACK_ITEM_POSITION)
  145.             '(
  146.               (setq selected_pos CALLBACK_ITEM_POSITION)
  147.               )
  148.             )
  149.     ))
  150. ;;
  151. ;; We add a method to set the items browsed by the list browser
  152. ;; and set the 'items' instance variable.
  153. ;;
  154. ;; (send <List_Browser_Widget_Class_inst> :set_browser_items <items_list>)
  155. ;; <items_list> is a list of BROWSER_OBJECTs as described above.
  156. ;;
  157. (send List_Browser_Widget_Class :answer :SET_BROWSER_ITEMS '(items_list)
  158.       '(
  159.     (let* (
  160.            (items_end_idx (length items_list))
  161.            (display_items (make-array items_end_idx)))
  162.  
  163.       (setq selected_pos nil)    ;reset ivar to init value.
  164.  
  165.       (if (= 0 items_end_idx)    ;if items_list empty
  166.           (setq items nil)        ;reset 'items' ivar to init value
  167.         (progn            ;else setup 'items' and 'display_items'
  168.           ;; initialize the 'items' instance variable so that it
  169.           ;; holds all the BROWSER_OBJECTs passed in <items_list>
  170.           (setq items (make-array items_end_idx)) ;create the array
  171.           (do (            ;copy elts from list to array
  172.            (i    0          (1+ i))
  173.            (elts items_list (cdr elts)))
  174.           ;; loop till no more elts
  175.           ((null elts))
  176.           ;; loop body
  177.           (setf (aref items i) (car elts))
  178.           (setf (aref display_items i) (send (car elts) :display_string))
  179.           )
  180.           )
  181.         )
  182.  
  183.       ;; tell the widget about the new browser items to display
  184.       (send-super :set_values
  185.               :XMN_ITEMS display_items
  186.               :XMN_ITEM_COUNT items_end_idx
  187.               )
  188.       )
  189.     ))
  190. ;;
  191. ;; Retrieves object at selected position, else NIL. 'selected_pos' is set by
  192. ;; :XMN_BROWSE_SELECTION_CALLBACK in :ISNEW method.
  193. ;;
  194. (send List_Browser_Widget_Class :answer :GET_SELECTED_ITEM '()
  195.       '(
  196.     (if selected_pos
  197.         (aref items (1- selected_pos))
  198.       NIL)
  199.     ))
  200. ;;
  201. ;; Brings up editor on object at selected position
  202. ;;
  203. (send List_Browser_Widget_Class :answer :EDIT_SELECTED_ITEM '()
  204.       '(
  205.     (let ((browsed-object (send self :get_selected_item)))
  206.       (if browsed-object        ;set to NIL if no browsed object
  207.           (system (format nil 
  208.                   "~A +~A ~A &"
  209.                   (if *SYSTEM-EDITOR* *SYSTEM-EDITOR* "$EDITOR")
  210.                   (send browsed-object :line-num)
  211.                   (send browsed-object :file-name)
  212.                   ))
  213.         ))
  214.     ))
  215. ;;
  216. ;; Select next item in list.
  217. ;;
  218. (send List_Browser_Widget_Class :answer :GOTO_NEXT '()
  219.       '(
  220.     (if items            ;trap empty list...
  221.         (progn
  222.           ;; ensure that the position remains valid
  223.           (if (not (numberp selected_pos)) ;if no current selection,
  224.           (setq selected_pos 1)    ;then start at beginning of list
  225.         (if (>= selected_pos (length items))
  226.             (format T "\007\n")    ;replace this with XBeep...
  227.           (setq selected_pos (1+ selected_pos))
  228.           )
  229.         )
  230.  
  231.           ;; select the next position
  232.           (send-super :select_pos selected_pos t)
  233.  
  234.           ;; make sure the item is visible
  235.           (let (num-br-visible num-br-items)
  236.         (send self :get_values
  237.               :XMN_ITEM_COUNT 'num-br-items
  238.               :XMN_VISIBLE_ITEM_COUNT 'num-br-visible)
  239.         (send self :set_bottom_pos
  240.               (min num-br-items (+ selected_pos (/ num-br-visible 2))))
  241.         )
  242.           ))
  243.     ))
  244. ;;
  245. ;; Select previous item in list
  246. ;;
  247. (send List_Browser_Widget_Class :answer :GOTO_PREV '()
  248.       '(
  249.  
  250.     (if items            ;trap empty list...
  251.         (progn
  252.           ;; ensure that the position remains valid
  253.           (if (not (numberp selected_pos))
  254.           (setq selected_pos 1)    ;if no current selection, start at beginning.
  255.         (if (= selected_pos 1)
  256.             (format T "\007\n")    ;replace this with XBeep...
  257.           (setq selected_pos (1- selected_pos))
  258.           )
  259.         )
  260.  
  261.           ;; select the prev position
  262.           (send-super :select_pos selected_pos t)
  263.  
  264.           ;; make sure the item is visible
  265.           (let* (visible-items)
  266.         (send self :get_values :XMN_VISIBLE_ITEM_COUNT 'visible-items)
  267.         (send self :set_pos (max 1 (- selected_pos (/ visible-items 2))))
  268.         )
  269.           ))
  270.     ))
  271. ;;
  272. ;; Select next item in list and browse it.
  273. ;;
  274. (send List_Browser_Widget_Class :answer :BROWSE_NEXT '(XEVENT)
  275.       '(
  276.     (send self :goto_next)
  277.     (send-super :call_action_proc "ListKbdActivate" XEVENT)    ;call :XMN_DEFAULT_ACTION_CALLBACK defined below.
  278.     ))
  279. ;;
  280. ;; Select previous item in list and browse it.
  281. ;;
  282. (send List_Browser_Widget_Class :answer :BROWSE_PREV '(XEVENT)
  283.       '(
  284.     (send self :goto_prev)
  285.     (send-super :call_action_proc "ListKbdActivate" XEVENT)    ;call :XMN_DEFAULT_ACTION_CALLBACK defined below.
  286.     ))
  287.  
  288. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  289. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Grep_Item_Class ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  290. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  291.  
  292. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  293. ;; Define a BROWSER_OBJECT
  294. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  295. ;;
  296. ;; Each BROWSER_OBJECT holds the information summarizing one mail message.
  297. ;; the information is split up into individual fields because we may want
  298. ;; to be able to sort on one field, or search for mathes on one field.
  299. ;;
  300. (setq Grep_Item_Class
  301.       (send Class :new
  302.         '(file-name line-num match-line)
  303.         ))
  304.  
  305. ;; this method will read a single line of grep output.
  306. ;; and sets the instance variables in the 
  307. ;; BROWSER_OBJECT to the individual fields of the grep output
  308. (send Grep_Item_Class :answer :read-grep-info '(pipe)
  309.       '(
  310.     (if (and
  311.          (setq file-name (fscanf-string pipe "%[^:]:"))
  312.          (setq line-num  (fscanf-fixnum pipe "%d:"))
  313.          (setq match-line (fscanf-string pipe "%[^\n]\n"))
  314.          )
  315.         self            ;return self if succesful
  316.       NIL                ;return NIL if hit EOF
  317.       )
  318.     )
  319.       )
  320.  
  321. (send Grep_Item_Class :answer :display_string '()
  322.       '(
  323.     (format nil "~A: ~A"
  324.         file-name match-line)
  325.     ))
  326.  
  327. (send Grep_Item_Class :answer :file-name '()
  328.       '(
  329.     file-name
  330.     ))
  331.  
  332. (send Grep_Item_Class :answer :line-num '()
  333.       '(
  334.     line-num
  335.     ))
  336.  
  337. ;;
  338. ;; This returns a list of Grep_Item_Class instances corresponding
  339. ;; to the items matching the search pattern and file list given
  340. ;; in argument <grep-arg-string>
  341. ;;
  342. (defun grep (executable-string flags-string grep-args-string)
  343.   (do* 
  344.    (;; loop variables, initializers, and increments.
  345.     (fp (popen (strcat
  346.         executable-string " "
  347.         flags-string " "
  348.         "-n "            ;force grep to output line numbers
  349.         grep-args-string
  350.         " /dev/null"        ;incase there's only one arg, forces filename to be output
  351.         )
  352.            :direction :input))
  353.     (line (send (send Grep_Item_Class :new) :read-grep-info fp)
  354.       (send (send Grep_Item_Class :new) :read-grep-info fp))
  355.     (result '())            ;init to an empty list
  356.     )
  357.    ;; loop test and return
  358.    ((null line)                ;:read-grep-info returns NIL on EOF
  359.     (pclose fp)                ;close the pipe opened above
  360.     (reverse result)            ;return list of grep objects.
  361.     )
  362.    ;; loop body
  363.    (setq result (cons line result))    ;prepend grep-obj to list
  364.    )
  365.   )
  366.  
  367. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  368. ;;;;;;;;;;;;;;;;;;;;;;;;;; Text_Viewer_Widget_Class ;;;;;;;;;;;;;;;;;;;;;;;;;;
  369. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  370.  
  371. ;;
  372. ;; Make a subclass of XM_TEXT_WIDGET_CLASS which holds an additional
  373. ;; instance variable 'file-path'. 'file-path' is a string representing
  374. ;; the full name of the file in the text editor widget.
  375. ;;
  376. ;; Method :FIND_FILE uses this filename to decide whether it must
  377. ;; read the file into the text widget, or whether it's already 
  378. ;; there. We don't want it to reread uncecessarily since for large
  379. ;; files, this can be slow...
  380. ;;
  381. (setq Text_Viewer_Widget_Class
  382.       (send Class :new
  383.         '(file-path)        ;new instance vars
  384.         '()                ;no class vars
  385.         XM_TEXT_WIDGET_CLASS))    ;superclass
  386.  
  387. ;;
  388. ;; Override superclass's instance initializer so we can set
  389. ;; instance variable, and supply some default arguments.
  390. ;;
  391. (send Text_Viewer_Widget_Class :answer :isnew
  392.       '(managed_k widget_name widget_parent &rest args)
  393.       '(
  394.     (setq file-path "")        ;initialize instance var
  395.     (apply 'send-super        ;call superclass's init to create widget
  396.            `(:isnew ,managed_k :scrolled ,widget_name ,widget_parent
  397.             ,@args
  398.             :XMN_EDIT_MODE :MULTI_LINE_EDIT
  399.             :XMN_EDITABLE  nil ;don't allow user to change text.
  400.             ))
  401.     ))
  402.  
  403. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  404. ;; Add a :FIND_FILE method to the Motif Text widget.
  405. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  406. (send Text_Viewer_Widget_Class :answer :FIND_FILE '(filename linenum)
  407.       '(
  408.     (cond
  409.      ((string= filename file-path)    ;if the file was already read into widget
  410.       (send-super :set_insertion_position 0) ;then just make <linenum> be center
  411.       (send-super :scroll (-    ;scroll to current line num
  412.                    linenum
  413.                    (/ (send-super :get :XMN_ROWS) 2)
  414.                    1))
  415.       )
  416.      (t                ;else read the file into the widget...
  417.       (let*
  418.           (;; loc vars
  419.            (fp
  420.         (open filename :direction :input)
  421.         )
  422.            inspos
  423.            text_line
  424.            )
  425.  
  426.         (if (null fp)
  427.         (error "Can't open file." filename))
  428.  
  429.         (send-super :set_string "")    ;clear out old text
  430.         (send-super :disable_redisplay NIL)    ;don't show changes till done
  431.         (loop
  432.          (if (null (setq text_line (read-line fp)))
  433.          (return))
  434.          (setq inspos (send-super :get_insertion_position))
  435.          (send-super :replace inspos inspos (strcat text_line "\n"))
  436.          )
  437.  
  438.         (send-super :scroll (-    ;scroll to current line num
  439.                  linenum
  440.                  (/ (send-super :get :XMN_ROWS) 2)
  441.                  1))
  442.  
  443.         (send-super :enable_redisplay) ;now show changes...
  444.  
  445.         (close fp)
  446.         (setq file-path filename)
  447.         )
  448.       )
  449.      )
  450.     ))
  451.  
  452. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  453. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GREP-BROWSER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  454. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  455.  
  456. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  457. ;; The Main program -- note that this doesn't use any global variables, so
  458. ;; you can have many grep browsers up all at once without having them
  459. ;; interact.
  460. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  461. (defun grep-browser()
  462.   (let
  463.       (;; declare local variables
  464.        (motif-v-1-0-p (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0)))
  465.        top_w paned_w controlpanel_w controlpanel3_w clone_button_w
  466. #| ;; NPM: commented out because simple-option-menu has motif bug
  467.        grepprog_opt_w
  468. |# ;; NPM: commented out because simple-option-menu has motif bug
  469.        doit_button_w case_toggle_w
  470.        search_label_w  files_label_w 
  471.        controlpanel2_w prev_button_w next_button_w
  472.        srchsel_button_w edit_file_button_w
  473.        filename_label_label_w filename_label_w
  474.        list_w viewtext_w search_editor_w files_editor_w
  475.        )
  476.  
  477.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  478.     ;;;;;;;;;;;;;;;;;;;;;;;;;;; Create A Widget Hierarchy ;;;;;;;;;;;;;;;;;;;;;;;;
  479.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  480.  
  481.     (setq top_w
  482.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "winterpGrepBr" "WinterpGrepBr"
  483.         :XMN_TITLE "Grep Browser"
  484.         :XMN_ICON_NAME "Grep Browser"
  485.         ))
  486.     (setq paned_w
  487.       (send XM_PANED_WINDOW_WIDGET_CLASS :new :managed
  488.         "paned_w" top_w 
  489.         ))
  490.     (setq controlpanel_w
  491.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed
  492.         "controlpanel_w" paned_w 
  493.         :XMN_ORIENTATION    :horizontal
  494.         :XMN_PACKING        :pack_tight
  495.         ))
  496.     (setq clone_button_w
  497.       (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed
  498.         "clone_button_w" controlpanel_w 
  499.         :XMN_LABEL_STRING    "New Search Window"
  500.         ))
  501.     (setq doit_button_w
  502.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed ;NOTE -- this must be a WIDGET (not a GADGET) because ArmAndActivate() action is called below.
  503.         "doit_button_w" controlpanel_w 
  504.         :XMN_LABEL_STRING    "Do Search"
  505.         :XMN_FILL_ON_ARM    t
  506.         ))
  507.     (setq srchsel_button_w
  508.       (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed
  509.         "srchsel_button_w" controlpanel_w 
  510.         :XMN_LABEL_STRING    "Search for Selected Text"
  511.         ))
  512. #| ;; NPM: commented out because simple-option-menu has motif bug
  513.     (if (not motif-v-1-0-p)
  514.     (setq grepprog_opt_w
  515.           (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed :simple_option_menu
  516.             "grep-opt" controlpanel_w
  517.             ;; :XMN_OPTION_LABEL "Search\nProgram:"
  518.             :XMN_OPTION_MNEMONIC    #\P
  519.             :XMN_BUTTON_COUNT        (length *GREP-EXECUTABLES*)
  520.             :XMN_BUTTONS        *GREP-EXECUTABLES*
  521.             :XMN_BUTTON_MNEMONICS    #(#\g #\f #\e #\n)
  522.             :XMN_BUTTON_SET        0
  523.             )))
  524. |# ;; NPM: commented out because simple-option-menu has motif bug
  525.  
  526.     (setq case_toggle_w
  527.       (send XM_TOGGLE_BUTTON_GADGET_CLASS :new :managed
  528.         "case_toggle_w" controlpanel_w 
  529.         :XMN_LABEL_STRING    "Case Sensitive Search"
  530.         :XMN_SET        T
  531.         ))
  532.     (setq controlpanel3_w
  533.       (send XM_FORM_WIDGET_CLASS :new :managed
  534.         "controlpanel3_w" paned_w 
  535.         ))
  536.     (setq search_label_w
  537.       (send XM_LABEL_GADGET_CLASS :new :managed
  538.         "search_label_w" controlpanel3_w
  539.         :XMN_LABEL_STRING    "Search Regexp:"
  540.         :XMN_TOP_ATTACHMENT    :attach_form
  541.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  542.         :XMN_LEFT_ATTACHMENT    :attach_form
  543.         ))
  544.     (setq search_editor_w
  545.       (send XM_TEXT_WIDGET_CLASS :new :managed ;note that XM_TEXT_FIELD_WIDGET_CLASS is glitchy with :XMN_RESIZE_WIDTH & :XMN_ALLOW_RESIZE set
  546.         "search_editor_w" controlpanel3_w
  547.         :XMN_EDIT_MODE    :SINGLE_LINE_EDIT
  548.         :XMN_RESIZE_WIDTH    t
  549.         :XMN_ALLOW_RESIZE    t
  550.         :XMN_CURSOR_POSITION_VISIBLE t
  551.         :XMN_TOP_ATTACHMENT    :attach_form
  552.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  553.         :XMN_LEFT_ATTACHMENT    :attach_form
  554.         :XMN_LEFT_ATTACHMENT    :attach_widget
  555.         :XMN_LEFT_WIDGET    search_label_w
  556.         ))
  557.     (setq files_label_w
  558.       (send XM_LABEL_GADGET_CLASS :new :managed
  559.         "files_label_w" controlpanel3_w
  560.         :XMN_LABEL_STRING    "Wildcarded Files:"
  561.         :XMN_TOP_ATTACHMENT    :attach_form
  562.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  563.         :XMN_LEFT_ATTACHMENT    :attach_widget
  564.         :XMN_LEFT_WIDGET    search_editor_w
  565.         ))
  566.     (setq files_editor_w
  567.       (send XM_TEXT_WIDGET_CLASS :new :managed ;note that XM_TEXT_FIELD_WIDGET_CLASS is glitchy with :XMN_RESIZE_WIDTH & :XMN_ALLOW_RESIZE set
  568.         "files_editor_w" controlpanel3_w
  569.         :XMN_EDIT_MODE    :SINGLE_LINE_EDIT
  570.         :XMN_RESIZE_WIDTH    t
  571.         :XMN_ALLOW_RESIZE    t
  572.         :XMN_CURSOR_POSITION_VISIBLE t
  573.         :XMN_TOP_ATTACHMENT    :attach_form
  574.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  575.         :XMN_LEFT_ATTACHMENT    :attach_widget
  576.         :XMN_LEFT_WIDGET    files_label_w
  577.         :XMN_RIGHT_ATTACHMENT    :attach_form
  578.         ))
  579.     (setq list_w
  580.       (send List_Browser_Widget_Class :new :managed :scrolled
  581.         "list_w" paned_w
  582.         :XMN_VISIBLE_ITEM_COUNT    8
  583.         :XMN_LIST_SIZE_POLICY    :RESIZE_IF_POSSIBLE
  584.         ))
  585.     (setq controlpanel2_w
  586.       (send XM_FORM_WIDGET_CLASS :new :managed
  587.         "controlpanel2_w" paned_w 
  588.         ))
  589.     (setq prev_button_w
  590.       (send XM_ARROW_BUTTON_GADGET_CLASS :new :managed
  591.         "prev_button_w" controlpanel2_w 
  592.         :XMN_ARROW_DIRECTION    :arrow_up
  593.         :XMN_TOP_ATTACHMENT    :attach_form
  594.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  595.         :XMN_LEFT_ATTACHMENT    :attach_form
  596.         ))
  597.     (setq next_button_w
  598.       (send XM_ARROW_BUTTON_GADGET_CLASS :new :managed
  599.         "prev_button_w" controlpanel2_w 
  600.         :XMN_ARROW_DIRECTION    :arrow_down
  601.         :XMN_TOP_ATTACHMENT    :attach_form
  602.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  603.         :XMN_LEFT_ATTACHMENT    :attach_form
  604.         :XMN_LEFT_ATTACHMENT    :attach_widget
  605.         :XMN_LEFT_WIDGET    prev_button_w
  606.         ))
  607.     (setq edit_file_button_w
  608.       (send XM_PUSH_BUTTON_GADGET_CLASS :new :managed
  609.         "edit_button_w" controlpanel2_w 
  610.         :XMN_LABEL_STRING    "$EDITOR(sel)"
  611.         :XMN_TOP_ATTACHMENT    :attach_form
  612.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  613.         :XMN_LEFT_ATTACHMENT    :attach_widget
  614.         :XMN_LEFT_WIDGET    next_button_w
  615.         ))
  616.     (setq filename_label_label_w
  617.       (send XM_LABEL_GADGET_CLASS :new :managed
  618.         "filename_label_label_w" controlpanel2_w
  619.         :XMN_LABEL_STRING    " Viewed File:"
  620.         :XMN_TOP_ATTACHMENT    :attach_form
  621.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  622.         :XMN_LEFT_ATTACHMENT    :attach_widget
  623.         :XMN_LEFT_WIDGET    edit_file_button_w
  624.         :XMN_ALIGNMENT        :alignment_end
  625.         ))
  626.     (setq filename_label_w
  627.       (send XM_LABEL_GADGET_CLASS :new :managed
  628.         "filename_label_w" controlpanel2_w
  629.         :XMN_LABEL_STRING    "[ None ]"
  630.         :XMN_TOP_ATTACHMENT    :attach_form
  631.         :XMN_BOTTOM_ATTACHMENT    :attach_form
  632.         :XMN_LEFT_ATTACHMENT    :attach_widget
  633.         :XMN_LEFT_WIDGET    filename_label_label_w
  634.         :XMN_RIGHT_ATTACHMENT    :attach_form
  635.         :XMN_ALIGNMENT        :alignment_beginning
  636.         ))
  637.     (setq viewtext_w
  638.       (send Text_Viewer_Widget_Class :new :managed
  639.         "viewtext_w" paned_w
  640.         :XMN_ROWS        10
  641.         :XMN_COLUMNS        80
  642.         ))
  643.  
  644.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  645.     ;;;;;;;;;;;;;;;;;;;;;;;;;; Setup Keyboard Accelerators ;;;;;;;;;;;;;;;;;;;;;;;
  646.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  647.  
  648.     (send list_w :set_values
  649.       :XMN_TRANSLATIONS    "#override \
  650.         <Btn2Down>:       ListBeginSelect() \
  651.         <Btn2Up>:    ListEndSelect() ListKbdActivate() \
  652.         <Btn3Down>:    ListBeginSelect() \
  653.         <Btn3Up>:    ListEndSelect() Lisp(send ACTION_WIDGET :edit_selected_item)"
  654.       :XMN_ACCELERATORS    "#override \
  655.         <Key>E:        Lisp(send ACTION_WIDGET :edit_selected_item) \
  656.         Ctrl<Key>N:    Lisp(send ACTION_WIDGET :goto_next) \
  657.         Ctrl<Key>osfDown: Lisp(send ACTION_WIDGET :goto_next) \
  658.         Ctrl<Key>P:    Lisp(send ACTION_WIDGET :goto_prev) \
  659.         Ctrl<Key>osfUp:    Lisp(send ACTION_WIDGET :goto_prev) \
  660.         <Key>N:        Lisp(send ACTION_WIDGET :browse_next ACTION_XEVENT) \
  661.         <Key>osfDown:    Lisp(send ACTION_WIDGET :browse_next ACTION_XEVENT) \
  662.         <Key>P:        Lisp(send ACTION_WIDGET :browse_prev ACTION_XEVENT) \
  663.         <Key>osfUp:    Lisp(send ACTION_WIDGET :browse_prev ACTION_XEVENT)"
  664.       )
  665.  
  666.     (send viewtext_w :set_values
  667.       :XMN_ACCELERATORS    "#override \
  668.         <Key>space:       next-page() \
  669.         <Key>osfBackSpace: previous-page()"
  670.       )
  671.  
  672.      (send list_w :install_all_accelerators top_w)
  673.      (send viewtext_w :install_all_accelerators top_w)
  674.      (send controlpanel_w :install_all_accelerators top_w)
  675.      (send controlpanel2_w :install_all_accelerators top_w)
  676.      (send controlpanel3_w :install_all_accelerators top_w)
  677.      (send paned_w :install_all_accelerators top_w)
  678.      (send doit_button_w :install_all_accelerators top_w) ;this is a widget, so it needs accels, all other buttons are gadgets so they don't...
  679.  
  680.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  681.     ;;; Realize Widgets to find out real sizes, then diddle constraints... ;;;;;;;
  682.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  683.  
  684.     (send top_w :realize)
  685.  
  686.     ;;
  687.     ;; set constraint resources on controlpanels so that paned window
  688.     ;; doesn't give them resize sashes.
  689.     ;;
  690.     (let (height)
  691.  
  692.       (send controlpanel_w :get_values :xmn_height 'height)
  693.       (send controlpanel_w :set_values
  694.         (if motif-v-1-0-p :XMN_MAXIMUM :XMN_PANE_MAXIMUM) height
  695.         (if motif-v-1-0-p :XMN_MINIMUM :XMN_PANE_MINIMUM) height
  696.         )
  697.  
  698.       (send controlpanel2_w :get_values :xmn_height 'height)
  699.       (send controlpanel2_w :set_values
  700.         (if motif-v-1-0-p :XMN_MAXIMUM :XMN_PANE_MAXIMUM) height
  701.         (if motif-v-1-0-p :XMN_MINIMUM :XMN_PANE_MINIMUM) height
  702.         )
  703.  
  704.       (send controlpanel3_w :get_values :xmn_height 'height)
  705.       (send controlpanel3_w :set_values
  706.         (if motif-v-1-0-p :XMN_MAXIMUM :XMN_PANE_MAXIMUM) height
  707.         (if motif-v-1-0-p :XMN_MINIMUM :XMN_PANE_MINIMUM) height
  708.         )
  709.       )
  710.  
  711.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  712.     ;;;;;;;;;;;;;;;;;;;;;;;;;;  Setup Callbacks ... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  713.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  714.  
  715.     ;;
  716.     ;; The "Clone" button creates another browser
  717.     ;;
  718.     (send clone_button_w :add_callback :XMN_ACTIVATE_CALLBACK '()
  719.       `(
  720.         (grep-browser)
  721.         ))
  722.     ;;
  723.     ;; The doit_button initiates a grep search.
  724.     ;;
  725.     (send doit_button_w :add_callback :XMN_ARM_CALLBACK '() ;NOTE -- using :XMN_ARM_CALLBACK rather than :XMN_ACTIVATE_CALLBACK because the former will keep the button filled (indicating search-in-progress) while grep is doing it's thing.
  726.       `(
  727.         ;; clear out old list while 'grep' is thinking
  728.         (send ,list_w :set_browser_items '())
  729.         (send ,list_w :update_display)
  730.         
  731.         ;; set new list contents to result of grep
  732.         (send ,list_w :set_browser_items
  733.           (grep 
  734.            *GREP-BR-EXECUTABLE*    ;use this in place of commented out option menu code below ... for now.
  735. #| ;; NPM: commented out because simple-option-menu has motif bug
  736.                    (xm_string_get_l_to_r (send (send ,grepprog_opt_w :get :xmn_menu_history) :get :xmn_label_string))
  737. |# ;; NPM: commented out because simple-option-menu has motif bug
  738.                    (if (send ,case_toggle_w :get_state) "" "-i")
  739.            (strcat
  740.             "'"            ;quotify string to protect regexps from being expanded by shell
  741.             (send ,search_editor_w :get_string) ;string to search for
  742.             "' "        ;quotify string to protect regexps from being expanded by shell
  743.             (send ,files_editor_w :get_string)) ;wildcarded files
  744.            )
  745.           )
  746.         ))
  747.     ;;
  748.     ;; Bind doit_button arm callback to <return> key in search_editor_w.
  749.     ;;
  750.     (send search_editor_w :add_callback :XMN_ACTIVATE_CALLBACK '(CALLBACK_XEVENT)
  751.       `(
  752.         (send ,doit_button_w :call_action_proc "ArmAndActivate" CALLBACK_XEVENT) 
  753.         ))
  754.     ;;
  755.     ;; Bind doit_button arm callback to <return> key in files_editor_w.
  756.     ;;
  757.     (send files_editor_w :add_callback :XMN_ACTIVATE_CALLBACK '(CALLBACK_XEVENT)
  758.       `(
  759.         (send ,doit_button_w :call_action_proc "ArmAndActivate" CALLBACK_XEVENT) 
  760.         ))
  761.     ;; 
  762.     ;; This callback will get the selection from the viewtext_w first, set
  763.     ;; that to the search string, and then call doit_button arm callback.
  764.     ;;
  765.     (send srchsel_button_w :add_callback :XMN_ACTIVATE_CALLBACK '(CALLBACK_XEVENT)
  766.       `(
  767.         (send ,search_editor_w :set_string (send ,viewtext_w :get_selection))
  768.         (send ,doit_button_w :call_action_proc "ArmAndActivate" CALLBACK_XEVENT) 
  769.         ))
  770.     ;;
  771.     ;; On pressing "View Selection in $EDITOR" button, call the *SYSTEM-EDITOR*,
  772.     ;; else call $EDITOR on file in view area.
  773.     ;;
  774.     (send edit_file_button_w :add_callback :XMN_ACTIVATE_CALLBACK '()
  775.       `(
  776.         (send ,list_w :edit_selected_item)
  777.         ))
  778.     ;;
  779.     ;; Add callbacks for buttons browsing prev/next items in list
  780.     ;;
  781.     (send prev_button_w :add_callback :XMN_ACTIVATE_CALLBACK '(CALLBACK_XEVENT)
  782.       `(
  783.         (send ,list_w :browse_prev CALLBACK_XEVENT)
  784.         ))
  785.     (send next_button_w :add_callback :XMN_ACTIVATE_CALLBACK '(CALLBACK_XEVENT)
  786.       `(
  787.         (send ,list_w :browse_next CALLBACK_XEVENT)
  788.         ))
  789.     ;;
  790.     ;; set up a callback on the list widget such that a double click (button 1)
  791.     ;; on the browser-item will browse the object.
  792.     ;;
  793.     (send list_w :add_callback :XMN_DEFAULT_ACTION_CALLBACK '()
  794.       `(
  795.         (let ((browsed-object (send ,list_w :get_selected_item)))
  796.           (if browsed-object    ;set to NIL if no browsed object
  797.           (let ((filename (send browsed-object :file-name))
  798.             (linenum  (send browsed-object :line-num)))
  799.             (send ,filename_label_w :set_values :XMN_LABEL_STRING filename)
  800.             (send ,filename_label_w :update_display) ;incase reading file takes long time
  801.             (send ,viewtext_w :find_file filename linenum)
  802.             ))
  803.           )
  804.         ))
  805.  
  806.     ))
  807.  
  808. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  809. ;;; bring up an instance of the grep browser upon loading this file.
  810. (grep-browser)
  811.  
  812. ) ;; end -- progn                    
  813. ) ;; end -- "if (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0))"
  814.